perm filename ASCINT.F4[1,LCS] blob sn#573308 filedate 1981-03-12 generic text, type T, neo UTF8
00100		SUBROUTINE ASCINT(I,RI,KNT,M)
00200	      DIMENSION KNT(72),RI(72),I(72)
00300	      INTEGER ZERO,NINE,KNT,J,I,DOT,BLA
00320	CC      INTEGER*1 ZERO,NINE,KNT,J,I,DOT,BLA
00400	      DATA DOT/'.'/,BLA/' '/,ZERO/'0'/,NINE/'9'/
01200	      DO 10 K=1,72
01300	10    KNT(K)=-1
01400	      IDEC=0
01500	      M=1
01600	      C=1.0
01700	      R=0
01800	      DO 5 K=1,72
01900	      J=I(K)
02000	      IF(J.EQ.BLA)GO TO 8
02100	      IF(J.NE.DOT)GO TO 6
02200	      IDEC=-1
02300	      GO TO 5
02400	6     IF(J.GE.ZERO.AND.J.LE.NINE)GO TO 7
02500	      CALL STOW(J,RI(M))
02600	      KNT(M)=0
02800	      GO TO 9
02900	7     IF(IDEC.NE.0)C=C*0.1
03000	      CALL CONV(R,J)
03100	      GO TO 5
03200	8     IF(R.EQ.0)GO TO 5
03300	      A=R*C
03500	      RI(M)=A
03600	      KNT(M)=1
03700	      R=0
03800	      C=1.0
03850		IDEC=0
03900	9     M=M+1
04000	5       CONTINUE
04100	      M=M-1
04700	        END
04800	 
04900	      SUBROUTINE CONV(R,J)
05000	CC      INTEGER*1 J
05100	CC      R=R*10.+J-48
05150		L=(J-'0')/536870912
05175		R=R*10.+L
05200	      END
05300	 
05400	      SUBROUTINE STOW(R,RI)
05500	      RI=R
05600	      END
05700	 
05800	      SUBROUTINE ASC(R)
05900	200   FORMAT(' ',A1)
06000	      WRITE(5,200)R
06100	      END
06200	      SUBROUTINE RNUM(R)
06300	201   FORMAT(F13.4)
06400	      WRITE(5,201)R
06500	      END